home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / cad / acadfont.zip / DIMFRACT.ZIP / DIMFRACD.LSP next >
Text File  |  1990-09-18  |  6KB  |  158 lines
  1. (defun C:DIMFRACD ()
  2.   (setq rgmd (getvar "REGENMODE"))
  3.   (setvar "REGENMODE" 0)                 ;Prevent automatic drawing regens
  4.   (setq styl (getvar "TEXTSTYLE"))
  5.   (command ".style" "ROMANDFR" "ROMANDFR" 0 1 0 "n" "n" "n")
  6.   (command ".style" styl "" "" "" "" "" "" "")
  7.   (princ "\nSelect Dimensions to be converted to fractions : ")
  8.   (setq ss (ssget))kE              ;Select Objects
  9.   (setq plen (sslength ss))
  10.   (setq n 0)                     ;Reset Index to 0
  11.   (if (> plen 0)
  12.     (while (< n plen)
  13.       (setq e1 (ssname ss n))
  14.       (setq en (entget e1))
  15.       (setq et (cdr (assoc 0 en)))
  16.       (setq en1 en)
  17.       (if (= et "TEXT") (fract_text))
  18.       (if (= et "DIMENSION")
  19.         (progn
  20.            (setq e0 (entlast))           ;Find last entity in drawing database
  21.            (setq en1 (entnext e0))       ;  so that entities added from
  22.            (while (not (null en1))       ;  explode can be distinguished
  23.               (setq e0 en1)
  24.               (setq en1 (entnext e0))
  25.            )
  26.            (command "explode" (getval -1 en))
  27.            (setq s0 (ssadd))      ;Create an empty selection set
  28.            (while (entnext e0) (ssadd (setq e0 (entnext e0)) s0))
  29.            (command "chprop" s0 "" "c" "bylayer" "lt" "bylayer"
  30.                                       "la" (getval 8 en) "")
  31.            (setq plen1 (sslength s0))
  32.            (setq n1 0)
  33.            (if (> plen1 0)       ;Change Text String as needed
  34.               (while (< n1 plen1)
  35.                  (progn
  36.                    (setq e11 (ssname s0 n1))
  37.                    (setq en1 (entget e11))
  38.                    (setq et1 (cdr (assoc 0 en1)))
  39.                    (if (= et1 "TEXT") (fract_text))
  40.                    (setq n1 (1+ n1))
  41.                  )    ;progn
  42.               )    ;while
  43.            )       ;if
  44.       ))
  45.       (setq n (1+ n))
  46.     )   ;while
  47.   )     ;if plen
  48.   (setvar "REGENMODE" rgmd)              ;Restore drawing regen mode
  49.   (print "DIMFRAC Complete ...")
  50.   (princ)
  51. )
  52.  
  53. (defun parse_etxt ()
  54.    (setq movdis 0)
  55.    (setq tht (cdr (assoc 40 en1)))     ;Get text height
  56.    (setq tloc (cdr (assoc 10 en1)))    ;Get text location
  57.    (setq trot (cdr (assoc 50 en1)))    ;Get text rotation
  58.    (setq txtlen (strlen etxt))
  59.    (setq si 1 slloc 0)
  60.    (while (<= si txtlen)
  61.      (progn
  62.        (if (= "/" (substr etxt si 1))
  63.           (setq slloc si)
  64.        )
  65.        (setq si (1+ si))
  66.    ))
  67.    (if (> slloc 0)
  68.       (progn
  69.          (setq denom (substr etxt (1+ slloc) 1))
  70.          (setq numer (substr etxt (1- slloc) 1))
  71.          (setq numer1 (substr etxt (- slloc 2) 1))
  72.          (setq ctest (ascii (substr etxt 1 1)))
  73.          (if (and (>= ctest 48) (<= ctest 57)) (setq mask 0) (setq mask -1))
  74.          (if (= denom "2") (setetx1 "i"))
  75.          (if (= denom "4")
  76.             (progn
  77.                (if (= numer "1") (setetx1 "r"))
  78.                (if (= numer "3") (setetx1 "s"))
  79.             )
  80.          )
  81.          (if (= denom "8")
  82.             (progn
  83.                (if (= numer "1") (setetx1 "w"))
  84.                (if (= numer "3") (setetx1 "y"))
  85.                (if (= numer "5") (setetx1 "p"))
  86.                (if (= numer "7") (setetx1 "f"))
  87.             )
  88.          )
  89.          (if (= denom "1")    ;(1/16")
  90.             (progn
  91.                (if (= numer "7") (setetx2 "u"))
  92.                (if (= numer "9") (setetx2 "o"))
  93.                (if (and (= numer1 " ") (= numer "1")) (setetx2 "q"))
  94.                (if (and (= numer1 " ") (= numer "3")) (setetx2 "e"))
  95.                (if (and (= numer1 " ") (= numer "5")) (setetx2 "t"))
  96.                (if (and (= numer1 "1") (= numer "1")) (setetx3 "a"))
  97.                (if (and (= numer1 "1") (= numer "3")) (setetx3 "d"))
  98.                (if (and (= numer1 "1") (= numer "5")) (setetx3 "g"))
  99.             )  ;progn
  100.          )    ;if 1/16"
  101.       )  ;progn
  102.    )
  103. )
  104.  
  105. ;-- Substitute fraction character for fraction string ("x/x")
  106. (defun setetx1 (ntx)
  107.     (if (>= slloc 3)
  108.        (setq etxt (strcat (substr etxt 1 (- slloc (+ 3 mask)))
  109.                ntx (substr etxt (+ slloc 2))))
  110.        (setq etxt (strcat ntx (substr etxt (+ slloc 2)))))
  111.     (setq movdis tht)
  112. )
  113. (defun setetx2 (ntx)
  114.     (if (>= slloc 3)
  115.        (setq etxt (strcat (substr etxt 1 (- slloc (+ 3 mask)))
  116.                ntx (substr etxt (+ slloc 3))))
  117.        (setq etxt (strcat ntx (substr etxt (+ slloc 3)))))
  118.     (setq movdis tht)
  119. )
  120. (defun setetx3 (ntx)
  121.     (if (>= slloc 4)
  122.        (setq etxt (strcat (substr etxt 1 (- slloc (+ 4 mask)))
  123.                ntx (substr etxt (+ slloc 3))))
  124.        (setq etxt (strcat ntx (substr etxt (+ slloc 3)))))
  125.     (setq movdis tht)
  126. )
  127.  
  128. (defun fract_text ()      ;Uses entity en1
  129.     (setq etxt (cdr (assoc 1 en1)))
  130.     (setq justi (cdr (assoc 72 en1)))
  131.     (parse_etxt)
  132.     (if (or (< ctest 48) (> ctest 57)) (setq movdis 0))
  133.     (if (> trot 0.5) (setq movvup movdis movdis 0) (setq movvup 0))
  134.     (if (> slloc 0)                  ;Only update if "/" found
  135.        (progn
  136.           (setq en1 (subst
  137.                         (cons 7 "ROMANDFR")
  138.                         (assoc 7 en1)
  139.                         en1
  140.                     )
  141.                 en1 (subst
  142.                         (cons 1 etxt)
  143.                         (assoc 1 en1)
  144.                         en1
  145.                     )
  146.                 en1 (subst
  147.                          (cons 10 (list (+ (car tloc) movdis)
  148.                                   (+ (cadr tloc) movvup) (cadr (cdr tloc))))
  149.                          (assoc 10 en1)
  150.                          en1
  151.                     )
  152.           )
  153.           (entmod en1)         ;Modify entity
  154.        )   ;prog
  155.     )    ;if slloc > 0
  156. )
  157.  
  158.